home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland Pascal with Objects 7.0 / HEAPSPY.ZIP / HWBITMAP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  3.5 KB  |  136 lines
  1. {$A-,B-,E-,F-,G+,I-,K-,N-,O-,P-,Q-,R-,S-,T+,V-,W-,X+}
  2.  
  3. {**********************************************}
  4. {                                              }
  5. {   HeapSpy - HWBitmap Module                  }
  6. {   Copyright (c) 1992  Borland International  }
  7. {                                              }
  8. {**********************************************}
  9.  
  10. unit HWBitmap;
  11.  
  12. {$C MOVEABLE DEMANDLOAD DISCARDABLE}
  13.  
  14. interface
  15.  
  16. uses Wintypes, WinProcs, Objects, ODialogs, OWindows, Strings, HWGlobal;
  17.  
  18. type
  19.   PBitmapWin = ^TBitMapWin;
  20.   TBitmapWin = object(TWindow)
  21.     RefObj: PWindowsObject;
  22.     BitmapHandle: Word;
  23.     PixelWidth,
  24.     PixelHeight: Word;
  25.     constructor Init(AParent: PWindowsObject; ARefObj: PWindowsObject;
  26.       hMem: Word);
  27.     destructor Done; virtual;
  28.     procedure Paint(PaintDC: HDC; var PaintStruct: TPaintStruct); virtual;
  29.     procedure WMKeyDown(var Msg: TMessage);
  30.       virtual wm_First + wm_KeyDown;
  31.     procedure WMSize(var Msg: TMessage);
  32.       virtual wm_First + wm_Size;
  33.     procedure WMSetFocus(var Msg: TMessage);
  34.       virtual wm_First + wm_SetFocus;
  35.   end;
  36.  
  37. implementation
  38.  
  39. constructor TBitmapWin.Init;
  40. var
  41.   Temp: array[0..127] of char;
  42.   BMP: PBitmapInfo;
  43.   BI: TBitMap;
  44.   BitsPtr: Pointer;
  45.   DC: hDC;
  46.   sz,bc: Word;
  47. begin
  48.   if not Odd(hMem) then Dec(hMem);
  49.   BMP := Ptr(hMem,0);
  50.   bc :=  BMP^.bmiHeader.biBitCount;
  51.   sz := BMP^.bmiHeader.biSize;
  52.   if sz = 12 then
  53.     sz := sz + ((1 shl bc) * SizeOf(TRGBTriple))
  54.   else
  55.     sz := sz + ((1 shl bc) * SizeOf(TRGBQuad));
  56.   RefObj := ARefObj;
  57.   BitsPtr := Ptr(hMem, sz);
  58.   DC := CreateDC('DISPLAY', nil, nil, nil);
  59.   BitmapHandle := CreateDIBitmap(DC, BMP^.bmiheader, cbm_init, BitsPtr,
  60.     BMP^, 0);
  61.   DeleteDC(DC);
  62.   if GetObject(BitmapHandle, SizeOf(TBitmap), @BI) = 0 then Fail;
  63.   PixelWidth := BI.bmWidth;
  64.   PixelHeight := BI.bmHeight;
  65.   WVSPrintF(TEMP, 'Bitmap - %#4X', BitmapHandle);
  66.   inherited Init(AParent,Temp);
  67.   with Attr do
  68.     Style := ws_vscroll or WS_HScroll;
  69.   Scroller := New(PScroller, Init(@Self, 1, 1, PixelHeight, PixelWidth));
  70. end;
  71.  
  72. destructor TBitmapWin.Done;
  73. begin
  74.   inherited Done;
  75.   DeleteObject(BitmapHandle);
  76. end;
  77.  
  78. procedure TBitmapWin.WMSetFocus;
  79. begin
  80.   DefWndProc(Msg);
  81.   SetWindowPos(RefObj^.HWindow, HWindow, 0, 0, 0, 0, swp_NoMove or
  82.     swp_NoSize or swp_NoActivate);
  83. end;
  84.  
  85. procedure TBitmapWin.WMKeyDown;
  86. var
  87.   CtrlPress: Boolean;
  88. begin
  89.   CtrlPress := GetKeyState(vk_Control) < 0;
  90.   if Scroller <> nil then
  91.   with Scroller^ do
  92.   case Msg.wParam of
  93.     vk_Up:    ScrollBy(0,-1);
  94.     vk_Down:  ScrollBy(0,1);
  95.     vk_Left:  ScrollBy(-1,0);
  96.     vk_Right: ScrollBy(1,0);
  97.     vk_Home:
  98.       if not CtrlPress then
  99.         ScrollTo(0,Ypos)
  100.       else
  101.         ScrollTo(0,0);
  102.     vk_End:
  103.       if not CtrlPress then
  104.         ScrollTo(XRange,YPos)
  105.       else
  106.         ScrollTo(XRange,YRange);
  107.     vk_Prior: ScrollBy(0,-YPage);
  108.     vk_Next:  ScrollBy(0,YPage);
  109.     end;
  110. end;
  111.  
  112. procedure TBitmapWin.WMSize;
  113. begin
  114.   inherited WMSize(Msg);
  115. end;
  116.  
  117. procedure TBitMapWin.Paint(PaintDC: HDC; var PaintStruct: TPaintStruct);
  118. var
  119.   MemoryDC: HDC;
  120.   OldBitmapHandle: THandle;
  121.   ClientRect: TRect;
  122. begin
  123.   if BitmapHandle <> 0 then
  124.   begin
  125.     MemoryDC := CreateCompatibleDC(PaintDC);
  126.     OldBitmapHandle := SelectObject(MemoryDC, BitmapHandle);
  127.     BitBlt(PaintDC, 0, 0, PixelWidth, PixelHeight, MemoryDC, 0, 0,
  128.       SrcCopy);
  129.     SelectObject(MemoryDC, OldBitmapHandle);
  130.     DeleteDC(MemoryDC);
  131.   end;
  132. end;
  133.  
  134.  
  135. end.
  136.